home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 August: Tool Chest / Dev.CD Aug 94.toast / Tool Chest / Development Platforms / Macintosh Common Lisp Related / Examples / edit-callers.lisp next >
Encoding:
Text File  |  1993-02-01  |  21.0 KB  |  532 lines  |  [TEXT/CCL2]
  1. ;-*- Mode: Lisp; Package: CCL -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; edit-callers.lisp
  4. ;;copyright © 1992, 1993, Apple Computer, Inc.
  5. ;;
  6. ;;
  7. ;;   pops up a dialog allowing you to choose from the callers of FUNCTION.
  8. ;;
  9. ;;
  10. ;
  11. ; usage: (edit-callers function)
  12. ;
  13. ; Uses %MAP-LFUNS which may cease to exist in a future version
  14. ; of MCL.
  15. ; This version uses smarter map-imms, requiring lots of specials, time 
  16. ; cut from .972 to .718 or so
  17.  
  18. ;;;;;;;;;;;;;;;;;;;;;;;;; edit history
  19. ; shortcomings 
  20. ; doesn't find things in plists, hash tables, action-function slots etc...
  21. ; but if there ain't no name it won't have source file info anyway (unless user does special stuff)
  22. ; 06/22/92 alice make initial hash table big enough for CCL at least
  23. ; 06/17/92 alice fix for no callers, somewhat faster, fix fix for duplicate methods
  24. ;  control-c and on tools menu, callers (setf ...) should work
  25. ; 06/16/92 alice fix for encapsulated things, weed out duplicate methods
  26. ; 06/15/92 alice ; extended alan ruttenberg's version to deal with swapped functions,
  27. ;         interpreted functions, and copying gc
  28.  
  29. (in-package :ccl)
  30.  
  31. (def-fred-command (:control #\c) 'ed-edit-callers)
  32.  
  33. (defparameter %edit-callers-string "")
  34. (defvar *edit-callers-dialog* nil)
  35.  
  36. (defmethod ed-edit-callers ((w fred-mixin) &optional pos)
  37.   (let ((form (ignore-errors (ed-current-sexp w pos))))
  38.     (cond ((not form)(edit-callers-dialog))
  39.           ((or (symbolp form)(and (consp form)(eq (car form) 'setf)))
  40.            (edit-callers form))
  41.           (t (ed-beep)))))
  42.  
  43. (defun edit-callers-dialog (&aux (initial-string %edit-callers-string))
  44.   (let ((w (front-window)))
  45.     (when (and w (typep w 'fred-window))
  46.       (multiple-value-bind (b e)(selection-range w)
  47.         (when (neq b e)
  48.           (setq initial-string (buffer-substring (fred-buffer w) b e))))))
  49.   (if (and *edit-callers-dialog*
  50.            (wptr *edit-callers-dialog*))
  51.     (let ((di (current-key-handler *edit-callers-dialog*)))
  52.       (when di
  53.         (set-dialog-item-text di initial-string)
  54.         (set-selection-range di 0 (length initial-string)))
  55.       (window-select *edit-callers-dialog*))                             
  56.     (setq *edit-callers-dialog*
  57.           (get-string-from-user
  58.            "Enter the name of a symbol. The callers will be shown."
  59.            :window-title "Edit Callers"
  60.            :initial-string initial-string
  61.            :modeless t
  62.            :action-function
  63.            #'(lambda (new-string)
  64.                (let (sym)
  65.                  (unless (equal new-string "")
  66.                    (setq %edit-callers-string new-string)
  67.                    (setq sym (read-from-string new-string)) ;might be a list like (setf boo)
  68.                    (edit-callers sym))))))))
  69.  
  70. ; in the right place?
  71. (eval-when (:execute :load-toplevel)
  72.   (let* ((menu *tools-menu*)
  73.          (item (make-instance 'menu-item
  74.                  :menu-item-title "Edit Callers…"
  75.                  :menu-item-action 'edit-callers-dialog))
  76.          (item-list (slot-value menu 'item-list))
  77.          last)
  78.     (apply #'remove-menu-items menu item-list)
  79.     (do ((l item-list (cdr l)))
  80.         ((null l))
  81.       ; we assume there is one and it isn't first
  82.       (when (string= (slot-value (car l) 'title) "-")
  83.         (rplacd last (cons item l))
  84.         (return))
  85.       (setq last l))
  86.     (apply #'add-menu-items menu item-list)))
  87.     
  88.           
  89. (require :lapmacros)
  90. #| 
  91. (defmacro loop-over-immediates ((var type function) &body body)
  92.   `(let ((lfunv (%lfun-vector ,function)))
  93.      (let ((nm (lfun-vector-name lfunv)))
  94.        (dotimes (i (%count-immrefs lfunv))
  95.          (declare (fixnum i))
  96.          (let ((,var (%nth-immediate lfunv i)))
  97.            (when (neq im nm)
  98.            ,@body))))))
  99. |#
  100.  
  101.  
  102.  
  103. (defvar *function-parent-table* nil)
  104.  
  105.  
  106. (defun clear-function-parent-table ()
  107.   (setq *function-parent-table* nil))
  108.  
  109. ; make it a very weak hash table 
  110. (defvar *pre-gc-hook* #'clear-function-parent-table)
  111.  
  112. (defun copying-gc-p () ; if nz copying gc is on
  113.   (neq 0 (lap-inline ()
  114.            (move.l (a5 $Palt_dynamic_cons_area) acc))))
  115.  
  116. (defun full-gccount ()
  117.   (flet ((ptrcount (A5offset ephem)
  118.            (if ephem
  119.              (%get-unsigned-word (%get-ptr (%get-ptr (%currentA5) A5offset) $cons-area.pgc-count))
  120.              0)))         
  121.       (ptrcount $Pdynamic_cons_area t)))
  122.  
  123. (eval-when (:compile-toplevel :execute)
  124.   ; argument must be a variable
  125.   (defmacro lfun-vector-attributes (lfunv)
  126.     `(lap-inline () (:variable ,lfunv)
  127.        (move.l (varg ,lfunv) atemp0)
  128.        (move.w (atemp0 $lfv_attrib) acc)    
  129.        (ext.l acc)
  130.        (mkint acc)))
  131.   
  132.   (defmacro lfun-vector-bits (lfunv)
  133.     `(lap-inline () (:variable ,lfunv)
  134.        (move.l (varg ,lfunv) atemp0)
  135.        (move.l (atemp0 $lfv_bits) acc)
  136.        (mkint acc)))    
  137.   
  138.   ; macro maybe not be worth the trouble
  139.   (defmacro global-function-p (random &optional name)
  140.     (let ((thing (gensym)))
  141.       `(let* ((,thing ,random)
  142.               (name ,(or name `(function-name ,thing))))
  143.          (and name
  144.               (or (not (or (symbolp name)(and (consp name)(eq (car name) 'setf)))) ; maybe its (setf baz)
  145.                   (let ((fn  (fboundp name)))
  146.                     (and fn
  147.                          (progn
  148.                            (when (consp fn)(setq fn (car fn))) ; macro expanders!
  149.                            (eq ,thing fn)))))
  150.               name))))
  151.   )
  152.  
  153. (defun lfun-closure-p (lfun)
  154.   (lap-inline () (:variable lfun)
  155.               (move.l (varg lfun) atemp0)
  156.               (move.w (atemp0 2) dy)
  157.               (move.l nilreg acc)
  158.               (if# (eq (cmp.w ($ $sp-funcall_cclosure) dy))
  159.                 (add.w ($ $t_val) acc))))
  160.  
  161. ; make a macro ?
  162. (defun puthash-parent (im fun)
  163.   (when (functionp im) ; was (or (functionp im)(eq imtype $sym.fapply))
  164.     (if (global-function-p fun)
  165.       (setf (gethash im *function-parent-table*) fun)
  166.       (let ((ht (gethash im *function-parent-table*)))
  167.         (if (not ht)
  168.           (setf (gethash im *function-parent-table*) fun)
  169.           (unless (eq ht fun)
  170.             (if (consp ht)
  171.               (when (not (memq fun ht))(nconc ht (list fun)))
  172.               (if (not (global-function-p ht))
  173.                 (setf (gethash im *function-parent-table*) (list ht fun))))))))))       
  174.  
  175. ; all nil excludes swapped functions, default is include (can be very slow) (.739)
  176. (defun callers (function &optional (all t) 
  177.                          &aux cfun callers gccount retry loadp)
  178.   (declare (special cfun function callers))
  179.   (declare (optimize (speed 3)(safety 0)))
  180.   (if *function-parent-table*
  181.     (clrhash *function-parent-table*)
  182.     (setq *function-parent-table* (make-hash-table :size 700 :test 'eq :weak :value)))
  183.   (if (and (symbolp function) (fboundp function))
  184.     (setq cfun (symbol-function function)))
  185.   (if (and (consp function)(eq (car function) 'setf))
  186.     (let ((nm (cadr function)))
  187.       (setq function  (or (%setf-method nm)
  188.                           (and (setq nm (setf-function-name nm))
  189.                                (fboundp nm)
  190.                                nm)
  191.                           function))))  
  192.   (when (copying-gc-p) (setq gccount (full-gccount)))
  193.   (flet ((do-it (fun)
  194.            (declare (special fun))
  195.            (when (and gccount (neq gccount (full-gccount)))
  196.              (throw 'losing :lost))
  197.            (let ((lfunv (%lfun-vector fun loadp)))
  198.              (when lfunv
  199.                (let ((bits (lfun-vector-bits lfunv)))
  200.                  (declare (fixnum bits))
  201.                  (unless (or (and (logbitp $lfbits-cm-bit bits)(not (logbitp $lfbits-method-bit bits)))  ; combined method
  202.                              (and (logbitp $lfbits-trampoline-bit bits)(lfun-closure-p fun)))   ; closure (interp or compiled)
  203.                    (if (logbitp $lfbits-evaluated-bit bits)
  204.                      (when (callers-interp fun function cfun)
  205.                        (push fun callers))
  206.                      (when (or loadp (not (logbitp  $lfatr-slfunv-bit (the fixnum (lfun-vector-attributes lfunv)))))
  207.                        (let ((nm (lfun-vector-name lfunv)))
  208.                          (declare (special nm))
  209.                          (%map-lfimms 
  210.                           lfunv
  211.                           #'(lambda (im)
  212.                               (when (and (or (eq function im)
  213.                                              (and cfun (eq cfun im)))
  214.                                          (neq im nm))                             
  215.                                 (push fun callers)) 
  216.                               (when (functionp im) ; was (or (functionp im)(eq imtype $sym.fapply))
  217.                                 (if (global-function-p fun nm)
  218.                                   (setf (gethash im *function-parent-table*) fun)
  219.                                   (let ((ht (gethash im *function-parent-table*)))
  220.                                     (if (not ht)
  221.                                       (setf (gethash im *function-parent-table*) fun)
  222.                                       (unless (eq ht fun)
  223.                                         (if (consp ht)
  224.                                           (when (not (memq fun ht))(nconc ht (list fun)))
  225.                                           (if (not (global-function-p ht))
  226.                                             (setf (gethash im *function-parent-table*) (list ht fun))))))))))))))))))))
  227.     (declare (dynamic-extent #'do-it))
  228.     (loop
  229.       (cond ((eq :lost (catch 'losing      
  230.                          (%map-lfuns #'do-it)))
  231.              (when retry (error "Callers is losing"))
  232.              (setq callers nil)
  233.              (setq retry t))
  234.             (t (return))))    
  235.     (when all (setq loadp t)(map-swapped-lfuns #'do-it))
  236.     ;(%map-static-lfuns #'do-it t)  ; there are only 4 of these - is it worth the trouble?
  237.     ; Get rid of garbage methods - do we like this?
  238.     ; what about generic flet?    
  239.     (delete-if #'(lambda (thing)
  240.                    (or (functionp thing)
  241.                        (and (typep thing 'method)
  242.                             (let ((gf (fboundp (method-name thing))))
  243.                                (not (and (typep gf 'standard-generic-function)
  244.                                          (memq thing (%gf-methods gf))))))))
  245.                (delete-duplicates (mapcar 'top-level-caller callers)))))
  246.  
  247.  
  248.  
  249. (defun top-level-caller (function &optional the-list)
  250.   (or (global-function-p function)
  251.       (let ((name (function-name function)))
  252.         (and name (function-encapsulation name) name))
  253.       (let ((caller function) next)
  254.         (loop
  255.           (setq next (gethash caller *function-parent-table*))
  256.           (if  next           
  257.             (cond ((consp next)
  258.                    (when (null the-list)(push function the-list))
  259.                    (return
  260.                     (dolist (c next)
  261.                       (when (not (memq c the-list))
  262.                         (let ((res (top-level-caller c the-list)))
  263.                           (when (and res (not (functionp res)))
  264.                             (return res)))))))
  265.                   (t (let ((res (global-function-p next)))
  266.                        (when res (return res)))
  267.                      (when (null the-list)(push function the-list))
  268.                      (when (memq next the-list) (return))
  269.                      (push next the-list)
  270.                      (setq caller next)))
  271.             (return caller))))
  272.       function))
  273.  
  274.  
  275. (defun edit-callers (function &key
  276.                               (include-swapped t)
  277.                               (modelessp t)
  278.                               (window-title (format nil "Callers of ~A" function))
  279.                               (default-button-text "Edit")
  280.                               &aux w)
  281.   (declare (dynamic-extent initargs))
  282.   (let ((callers (with-cursor *watch-cursor* (callers function include-swapped))))
  283.     (setq callers (sort callers #'edit-definition-spec-lessp)) ; hmm sorts by specializers
  284.     (if (not callers)
  285.       (progn (format t "There are no callers of ~S" function)(ed-beep))
  286.       (setq w
  287.             (select-item-from-list
  288.              callers
  289.              :window-title window-title
  290.              :table-print-function 
  291.              #'(lambda (thing &optional (stream t))
  292.                  (if (typep thing 'standard-method)
  293.                    (let ((qualifiers (%method-qualifiers thing)))
  294.                      (format stream "<~s ~s ~s>" 
  295.                              (%method-name thing)
  296.                              (case (length qualifiers)
  297.                                (0 :primary)
  298.                                (1 (car qualifiers))
  299.                                (t qualifiers))
  300.                              (mapcar #'(lambda (class)
  301.                                          (if (consp class)
  302.                                            class
  303.                                            (or (class-name class) class)))
  304.                                      (%method-specializers thing))))
  305.                    (format stream "~s" thing)))
  306.              :modeless modelessp
  307.              :default-button-text default-button-text
  308.              :action-function
  309.              #'(lambda (list)
  310.                  (if (option-key-p) (window-close w))
  311.                  (edit-definition (car list))))))))
  312.  
  313. (defun map-swapped-lfuns (function)
  314.   (setq function (coerce-to-function function))
  315.   (let  ((p (%get-long (%currenta5) $slfuns_start))
  316.          (q (%get-long (%currenta5) $slfuns_end)))
  317.     (loop
  318.       (when (eq p q)(return))        
  319.       (funcall function (lap-inline (p) (jsr_subprim $sp-getulong)))
  320.       (setq p (%i+ p 8)))))
  321.  
  322. #|
  323. ;Map function over all static lfuns
  324. (defun %map-static-lfuns (function)
  325.   (setq function (coerce-to-function function))
  326.   (lap-inline ()
  327.     (:variable function)
  328.     (with-preserved-registers #(dsave0 asave0)
  329.       (move.l (varg function 8) asave0)      
  330.       (move.l (a5 $Pstatic_cons_area) atemp1)
  331.       (move.l (atemp1 $cons-area.gspace-start) atemp0)
  332.       (move.l (atemp1 $cons-area.gspace-end) dsave0)
  333.       (prog#
  334.        (move.l @atemp0 da)
  335.        (if# (ne (cmp.b ($ $object-header) da))
  336.          (add ($ 8) atemp0)
  337.          elseif# (eq (cmp.w ($ $symbol-header) da))
  338.          (lea (atemp0 $sym_size) atemp0)
  339.          else#
  340.          (if# (eq (cmp.w ($ $lfunv-header) da))
  341.            (add.w ($ $t_vector) atemp0)
  342.            (vpush atemp0)
  343.            (move.l ($ (+ $v_data $t_lfun)) arg_z)
  344.            (add.l atemp0 arg_z)
  345.            (set_nargs 1)
  346.            (jsr @asave0)
  347.            (move.l (a5 $Pstatic_cons_area) atemp1) ; why
  348.            (vpop atemp0)
  349.            (sub.w ($ $t_vector) atemp0))
  350.          (move.l ($ 15) da)
  351.          (add.l (atemp0 (+ $t_vector $v_log)) da)
  352.          (and.l ($ #x00FFFFF8) da)
  353.          (add.l da atemp0))
  354.        (until# (geu dsave0 atemp0)))))
  355.   nil)
  356. |#
  357.  
  358. (defun callers-interp (function target ctarget)
  359.   (let* ((lfunv (%lfun-vector function))
  360.          (body (%%nth-immediate lfunv 1)) ; might be 0 if $lfatr-noname-bit, or 2 if keys, or 3 if d.a.c.
  361.          calls-target)
  362.     ; crock!!!!! - what is the right way to do this?
  363.     (when (not (consp body))
  364.       (dotimes (i (%count-immrefs lfunv))
  365.         (let ((it (%%nth-immediate lfunv i)))
  366.           (when (consp it)(setq body it)(return)))))
  367.     (labels ((calls-in-progn (body)
  368.                (dolist (expr body)
  369.                  (calls-in-expr expr)))
  370.              (calls-in-expr (expr)
  371.                (when (consp expr)
  372.                  (let ((car (car expr)))
  373.                    (if (consp car)
  374.                      (ecase (car car)
  375.                        ; 34 special forms
  376.                        ((block progn if tagbody progv locally unwind-protect
  377.                                multiple-value-list multiple-value-prog1
  378.                                without-interrupts)
  379.                         (calls-in-progn (cdr expr)))
  380.                        (catch (calls-in-progn (cddr expr)))
  381.                        (multiple-value-call (calls-in-progn (cdr expr)))
  382.                        ((the return-from throw) (calls-in-expr (third expr)))                       
  383.                        ((%with-specials eval-when) (calls-in-progn (cddr expr)))
  384.                        ((%local-ref %special-ref quote %special-declare go
  385.                                     %closure-ref %special-bind))
  386.                        (%local-fref
  387.                         (puthash-parent (second car) function)
  388.                         (calls-in-progn (cdr expr)))
  389.                        (%init&bind (calls-in-expr (third expr)))
  390.                        ((let let* compiler-let)
  391.                         (let ((args (second expr)))
  392.                           (dolist (a args)
  393.                             (when (consp a) (calls-in-expr (second a))))
  394.                           (calls-in-progn (cddr expr))))
  395.                        ((flet labels macrolet symbol-macrolet)
  396.                         (calls-in-progn (cddr expr)))
  397.                        (setq
  398.                         (do ((l (cdr expr)(cddr l)))
  399.                             ((null l))
  400.                           (calls-in-expr (second l))))
  401.                        (function
  402.                         (let ((fn (second expr)))
  403.                           (if (symbolp fn)
  404.                             (when (eq fn target)(setq calls-target t))
  405.                             (progn
  406.                               (when (eq target ctarget)(setq calls-target t))
  407.                               (puthash-parent (second expr) function))))))
  408.                      (case car
  409.                        (%local-fref                        
  410.                         (puthash-parent (second expr) function))
  411.                        (quote)
  412.                        (t
  413.                         (when (eq car target)
  414.                           (setq calls-target t))
  415.                         (calls-in-progn (cdr expr)))))))))
  416.       (calls-in-progn body)
  417.       calls-target)))
  418. #|
  419. ; copy of %nth-immediate without calls to %count-immrefs and #'< - saves a lot!
  420. (defun %%nth-immediate (lfv i)
  421.   (new-lap
  422.    (:variable lfv i)
  423.     (move.l (varg lfv) atemp0)
  424.     (getvect atemp0 da)
  425.     (if# (ne (btst.w ($ $lfatr-slfunv-bit) (atemp0 (- $lfv_attrib $v_data))))
  426.       (sub.l ($ 4) da))
  427.     (lea (atemp0 da.l 0) atemp1)
  428.     (lea (atemp0 $t_lfun) atemp0)
  429.     (move.l (varg i) arg_y)
  430. @loop
  431.     (move.l ($ 0) da)
  432.     (move.b -@atemp1 da)
  433.     (if# (cs (add.b da da))
  434.       (rol.w ($ 8) da)
  435.       (move.b -@atemp1 da)
  436.       (rol.w ($ 8) da))
  437.     (add.l da atemp0)
  438.     (bif (pl (sub.l '1 arg_y)) @loop)
  439.     (move.l @atemp0 acc)
  440.     (if# (eq (ttagp ($ $t_symbol) acc da)) ; sets da.l to 0
  441.       (move.l acc atemp0)
  442.       (if# (ne (tst.w (atemp0 (- $t_symbol))))
  443.         (moveq $sym.gvalue da)
  444.         (if# (ne (tst.w (atemp0 (- (+ $t_symbol $sym.gvalue)))))
  445.           (moveq $sym.fapply da)))
  446.       (sub.l da acc)
  447.       (ext.w da)
  448.       (ext.l da)
  449.       (mkint da)
  450.       else#
  451.       (move.l nilreg da))
  452.     (vpush acc)
  453.     (vpush da)
  454.     (set_nargs 2)
  455.     (jmp_subprim $sp-nvalret)))
  456. |#
  457. ; this one returns a single value - saving 8.5% 
  458. (defun %%nth-immediate (lfv i)
  459.   (lap-inline ()
  460.    (:variable lfv i)
  461.     (move.l (varg lfv) atemp0)
  462.     (getvect atemp0 da)
  463.     (if# (ne (btst.w ($ $lfatr-slfunv-bit) (atemp0 (- $lfv_attrib $v_data))))
  464.       (sub.l ($ 4) da))
  465.     (lea (atemp0 da.l 0) atemp1)
  466.     (lea (atemp0 $t_lfun) atemp0)
  467.     (move.l (varg i) arg_y)
  468. @loop
  469.     (move.l ($ 0) da)
  470.     (move.b -@atemp1 da)
  471.     (if# (cs (add.b da da))
  472.       (rol.w ($ 8) da)
  473.       (move.b -@atemp1 da)
  474.       (rol.w ($ 8) da))
  475.     (add.l da atemp0)
  476.     (bif (pl (sub.l '1 arg_y)) @loop)
  477.     (move.l @atemp0 acc)
  478.     (if# (eq (ttagp ($ $t_symbol) acc da)) ; sets da.l to 0
  479.       (move.l acc atemp0)
  480.       (if# (ne (tst.w (atemp0 (- $t_symbol))))
  481.         (moveq $sym.gvalue da)
  482.         (if# (ne (tst.w (atemp0 (- (+ $t_symbol $sym.gvalue)))))
  483.           (moveq $sym.fapply da)))
  484.       (sub.l da acc))))
  485.  
  486. ; Calls function f with args (imm) on each immediate in lfv.
  487. (defun %map-lfimms (lfv f)
  488.   (lap-inline (lfv f)
  489.     (with-preserved-registers #(asave0 asave1 dsave0 dsave1 dsave2)
  490.       (move.l arg_y asave0) ; vect
  491.       (move.l arg_z asave1) ; fun
  492.       (vsize asave0 dsave0)
  493.       (lea (asave0 $lfv_attrib) atemp0)
  494.       (move.w atemp0@+ dx)
  495.       (if# (ne (btst ($ $lfatr-immmap-bit) dx))
  496.         (if# (ne (btst ($ $lfatr-slfunv-bit) dx))
  497.           (sub.l ($ 4) dsave0))
  498.         (moveq 0 dsave1)
  499.         (moveq '0 dsave2)
  500.         (until# (eq (progn (moveq 0 acc)
  501.                            (lea (asave0 dsave0.l $v_data) atemp1)
  502.                            (sub.l ($ 1) dsave0)
  503.                            (move.b -@atemp1 acc)))
  504.                 (if# (cs (add.b acc acc))
  505.                   (ror.w ($ 8) acc)
  506.                   (move.b -@atemp1 acc)
  507.                   (sub.l ($ 1) dsave0)
  508.                   (ror.w ($ 8) acc))
  509.                 (add.l acc dsave1)
  510.                 (moveq 0 arg_z)
  511.                 (move.l (asave0 dsave1.l $lfv_lfun) arg_y)
  512.                 (if# (ne (dtagp arg_y $t_symbol))
  513.                   (move.l arg_y atemp0)
  514.                   (if# (ne (tst.w -@atemp0))
  515.                     (add.w ($ 8) arg_z)
  516.                     (sub.w ($ 8) atemp0)
  517.                     (if# (ne (tst.w @atemp0))
  518.                       (add.w ($ 8) arg_z))))
  519.                 (sub.l arg_z arg_y)
  520.                 ;(mkint arg_z)
  521.                 (mkint dsave0)
  522.                 (mkint dsave1)
  523.                 (move.l arg_y arg_z)
  524.                 (add.l '1 dsave2)
  525.                 (set_nargs 1)
  526.                 (jsr @asave1)
  527.                 (getint dsave1)
  528.                 (getint dsave0)))))
  529.   nil)
  530.  
  531.  
  532.